home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch9 / Cannon.frm (.txt) < prev    next >
Visual Basic Form  |  1999-05-28  |  8KB  |  262 lines
  1. VERSION 5.00
  2. Begin VB.Form frmCannon 
  3.    BorderStyle     =   1  'Fixed Single
  4.    Caption         =   "Cannon"
  5.    ClientHeight    =   3765
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   7110
  9.    LinkTopic       =   "Form1"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   3765
  13.    ScaleWidth      =   7110
  14.    StartUpPosition =   3  'Windows Default
  15.    Begin VB.CommandButton cmdReset 
  16.       Caption         =   "Reset"
  17.       Height          =   375
  18.       Left            =   120
  19.       TabIndex        =   8
  20.       Top             =   3360
  21.       Width           =   615
  22.    End
  23.    Begin VB.PictureBox picHouseHit 
  24.       AutoSize        =   -1  'True
  25.       Height          =   330
  26.       Left            =   6720
  27.       Picture         =   "Cannon.frx":0000
  28.       ScaleHeight     =   270
  29.       ScaleWidth      =   285
  30.       TabIndex        =   7
  31.       Top             =   3360
  32.       Visible         =   0   'False
  33.       Width           =   345
  34.    End
  35.    Begin VB.PictureBox picHouseOk 
  36.       AutoSize        =   -1  'True
  37.       Height          =   330
  38.       Left            =   6240
  39.       Picture         =   "Cannon.frx":015A
  40.       ScaleHeight     =   270
  41.       ScaleWidth      =   285
  42.       TabIndex        =   6
  43.       Top             =   3360
  44.       Visible         =   0   'False
  45.       Width           =   345
  46.    End
  47.    Begin VB.TextBox txtSpeed 
  48.       Height          =   285
  49.       Left            =   3120
  50.       TabIndex        =   1
  51.       Text            =   "100"
  52.       Top             =   3390
  53.       Width           =   495
  54.    End
  55.    Begin VB.PictureBox picCanvas 
  56.       Height          =   3255
  57.       Left            =   0
  58.       ScaleHeight     =   213
  59.       ScaleMode       =   3  'Pixel
  60.       ScaleWidth      =   469
  61.       TabIndex        =   4
  62.       Top             =   0
  63.       Width           =   7095
  64.    End
  65.    Begin VB.TextBox txtAngle 
  66.       Height          =   285
  67.       Left            =   1680
  68.       TabIndex        =   0
  69.       Text            =   "45"
  70.       Top             =   3390
  71.       Width           =   495
  72.    End
  73.    Begin VB.CommandButton cmdFire 
  74.       Caption         =   "Fire"
  75.       Default         =   -1  'True
  76.       Height          =   375
  77.       Left            =   3960
  78.       TabIndex        =   2
  79.       Top             =   3360
  80.       Width           =   615
  81.    End
  82.    Begin VB.Label Label1 
  83.       Caption         =   "Speed"
  84.       Height          =   255
  85.       Index           =   1
  86.       Left            =   2520
  87.       TabIndex        =   5
  88.       Top             =   3390
  89.       Width           =   495
  90.    End
  91.    Begin VB.Label Label1 
  92.       Caption         =   "Angle"
  93.       Height          =   255
  94.       Index           =   0
  95.       Left            =   1080
  96.       TabIndex        =   3
  97.       Top             =   3390
  98.       Width           =   495
  99.    End
  100. Attribute VB_Name = "frmCannon"
  101. Attribute VB_GlobalNameSpace = False
  102. Attribute VB_Creatable = False
  103. Attribute VB_PredeclaredId = True
  104. Attribute VB_Exposed = False
  105. Option Explicit
  106. Private Const DISTANCE_SCALE = 10
  107. Private Const CANNON_SCALE = 10
  108. Private TargetX As Single
  109. Private BitmapWid As Long
  110. Private BitmapHgt As Long
  111. Private BitmapNumBytes As Long
  112. Private Bytes() As Byte
  113. ' ------------------
  114. ' Bitmap Information
  115. ' ------------------
  116. Private Type BITMAP
  117.     bmType As Long
  118.     bmWidth As Long
  119.     bmHeight As Long
  120.     bmWidthBytes As Long
  121.     bmPlanes As Integer
  122.     bmBitsPixel As Integer
  123.     bmBits As Long
  124. End Type
  125. Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
  126. Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
  127. Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
  128. ' Get the initial velocity components from the
  129. ' speed and angle.
  130. Private Sub GetInitialVelocity(ByRef vx As Single, ByRef vy As Single)
  131. Const PI = 3.14159365
  132. Dim angle As Single
  133. Dim speed As Single
  134.     ' Get the angle in radians and the speed.
  135.     On Error Resume Next
  136.     angle = CSng(txtAngle.Text) * PI / 180
  137.     speed = CSng(txtSpeed.Text)
  138.     vx = Cos(angle) * speed / DISTANCE_SCALE
  139.     vy = -Sin(angle) * speed / DISTANCE_SCALE
  140. End Sub
  141. ' Start the animation.
  142. Private Sub PlayImages()
  143. Const MS_PER_FRAME = 50
  144. Const SCALED_F = 16 / DISTANCE_SCALE
  145. Dim X As Single
  146. Dim Y As Single
  147. Dim hitx As Single
  148. Dim hity As Single
  149. Dim dhity As Single
  150. Dim not_hit As Boolean
  151. Dim vx As Single
  152. Dim vy As Single
  153. Dim dist As Single
  154. Dim next_time As Long
  155. Dim test_color As Long
  156.     ' Get the initial velocity and position.
  157.     GetInitialVelocity vx, vy
  158.     ' Start the point at the end of the cannon.
  159.     dist = Sqr(vx * vx + vy * vy)
  160.     X = vx / dist * CANNON_SCALE
  161.     Y = BitmapHgt + vy / dist * CANNON_SCALE
  162.     not_hit = True
  163.     next_time = GetTickCount()
  164.     Do
  165.         ' Subtract the force of gravity from the
  166.         ' Y velocity component.
  167.         vy = vy + SCALED_F
  168.         ' Restore the background.
  169.         SetBitmapBits picCanvas.Image, BitmapNumBytes, Bytes(1, 1)
  170.         ' See if we will hit the house.
  171.         If not_hit Then
  172.             dhity = vy / vx
  173.             hity = Y
  174.             For hitx = X To X + vx
  175.                 ' See if (hitx, hity) is a hit.
  176.                 test_color = picCanvas.Point(hitx, hity)
  177.                 If (test_color > 0) And _
  178.                     (test_color <> picCanvas.BackColor) _
  179.                 Then
  180.                     not_hit = False
  181.                     picCanvas.PaintPicture _
  182.                         picHouseHit.Picture, TargetX, _
  183.                         picCanvas.ScaleHeight - picHouseOk.ScaleHeight
  184.                     DoEvents
  185.                     ' Save the new background.
  186.                     SaveBackground
  187.                     Beep
  188.                     Exit For
  189.                 End If
  190.                 hity = hity + dhity
  191.             Next hitx
  192.         End If
  193.         ' Calculate the next position.
  194.         X = X + vx
  195.         Y = Y + vy
  196.         ' Draw the projectile.
  197.         picCanvas.PSet (X, Y), vbBlue
  198.         ' Wait until it's time for the next frame.
  199.         next_time = next_time + MS_PER_FRAME
  200.         WaitTill next_time
  201.     Loop While Y < BitmapHgt + 3
  202. End Sub
  203. ' Start the animation.
  204. Private Sub cmdFire_Click()
  205.     DrawBackground
  206.     PlayImages
  207. End Sub
  208. ' Move the target.
  209. Private Sub cmdReset_Click()
  210.     TargetX = picCanvas.ScaleWidth * (0.3 + Rnd * 0.6)
  211.     DrawBackground
  212.     cmdFire.SetFocus
  213. End Sub
  214. Private Sub Form_Load()
  215.     Randomize
  216.     Show
  217.     picCanvas.AutoRedraw = True
  218.     picCanvas.ScaleMode = vbPixels
  219.     picCanvas.DrawWidth = 3
  220.     picCanvas.FillStyle = vbSolid
  221.     picCanvas.BackColor = &HC0C0C0
  222.     picHouseOk.ScaleMode = vbPixels
  223.     picHouseHit.ScaleMode = vbPixels
  224.     cmdReset_Click
  225. End Sub
  226. ' Save the background bitmap data.
  227. Private Sub SaveBackground()
  228. Dim bm As BITMAP
  229.     GetObject picCanvas.Image, Len(bm), bm
  230.     BitmapWid = bm.bmWidthBytes
  231.     BitmapHgt = bm.bmHeight
  232.     BitmapNumBytes = BitmapWid * BitmapHgt
  233.     ReDim Bytes(1 To bm.bmWidthBytes, 1 To bm.bmHeight)
  234.     GetBitmapBits picCanvas.Image, BitmapNumBytes, Bytes(1, 1)
  235. End Sub
  236. ' Draw the target and the cannon pointed in the
  237. ' direction of the current angle.
  238. Private Sub DrawBackground()
  239. Dim vx As Single
  240. Dim vy As Single
  241. Dim dist As Single
  242. Dim bm As BITMAP
  243.     ' Clear the canvas.
  244.     picCanvas.Line (0, 0)-(picCanvas.ScaleWidth, picCanvas.ScaleHeight), picCanvas.BackColor, BF
  245.     ' Get the initial velocity components.
  246.     GetInitialVelocity vx, vy
  247.     ' Draw the target.
  248.     picCanvas.PaintPicture _
  249.         picHouseOk.Picture, TargetX, _
  250.         picCanvas.ScaleHeight - picHouseOk.ScaleHeight
  251.     ' Draw the cannon.
  252.     dist = Sqr(vx * vx + vy * vy)
  253.     vx = vx / dist
  254.     vy = vy / dist
  255.     picCanvas.Line (0, picCanvas.ScaleHeight)-Step(vx * CANNON_SCALE, vy * CANNON_SCALE), vbBlack
  256.     ' Save the background bitmap data.
  257.     SaveBackground
  258. End Sub
  259. Private Sub txtAngle_Change()
  260.     DrawBackground
  261. End Sub
  262.